unit MainUnit;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, Contnrs, Themes, PNGImage;

const
  mrError = -1;

type
  TMainForm = class(TForm)
    FrameTimer: TTimer;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure FrameTimerOnTimer(Sender: TObject);
    procedure FormMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure FormShow(Sender: TObject);
  strict private
    FImagePos: TPoint;
    FImageSize: TSize;
    FImageIndex: Integer;
    FImageArray: array of TBitmap;
    FRepeatCount: Integer;
    procedure ReleaseFrames;
    procedure RenderFrame(AFrameIndex: Integer);
    procedure ListSourceFiles(const ASourcePath: string; var AFileList: TStringList);
    procedure LoadSourceFiles(const ASourcePath: string; AFileList: TStringList);
  public
    function ShowAnimation(WindowOwner: HWND; const ASourcePath: string;
      AFrameTime: Integer; ARepeatCount: Integer): TModalResult;
  end;

var
  MainForm: TMainForm;

function IPInitializeIntro(WindowOwner: HWND; SourcePath: PWideChar;
  FrameTime: Integer): Integer; stdcall;
function IPInitializeAnimation(WindowOwner: HWND; SourcePath: PWideChar;
  FrameTime: Integer; RepeatCount: Integer): Integer; stdcall;

implementation

{$R *.dfm}

function IPInitializeIntro(WindowOwner: HWND; SourcePath: PWideChar;
  FrameTime: Integer): Integer;
begin
  MainForm := TMainForm.Create(nil);
  try
    MainForm.BorderStyle := bsNone;
    MainForm.FormStyle := fsStayOnTop;
    MainForm.Position := poScreenCenter;
    Result := MainForm.ShowAnimation(WindowOwner, SourcePath, FrameTime, 1);
  finally
    MainForm.Free;
  end;
end;

function IPInitializeAnimation(WindowOwner: HWND; SourcePath: PWideChar;
  FrameTime: Integer; RepeatCount: Integer): Integer;
begin
  MainForm := TMainForm.Create(nil);
  try
    MainForm.BorderStyle := bsNone;
    MainForm.FormStyle := fsStayOnTop;
    MainForm.Position := poScreenCenter;
    Result := MainForm.ShowAnimation(WindowOwner, SourcePath, FrameTime, RepeatCount);
  finally
    MainForm.Free;
  end;
end;

{ TMainForm }

procedure TMainForm.FormCreate(Sender: TObject);
begin
  {$IFDEF DEBUG}
  ReportMemoryLeaksOnShutdown := True;
  {$ENDIF}
  FrameTimer.Enabled := False;
end;

procedure TMainForm.FormDestroy(Sender: TObject);
begin
  FrameTimer.Enabled := False;
  ReleaseFrames;  
end;

procedure TMainForm.FormShow(Sender: TObject);
begin
  FImageIndex := -1;
  FrameTimerOnTimer(nil);
  FrameTimer.Enabled := True;
end;

procedure TMainForm.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  FrameTimer.Enabled := False;
  FImageIndex := -1;
end;

procedure TMainForm.FormMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
const
  SC_DRAGMOVE = $F012;
begin
//  if Button = mbLeft then
//  begin
//    ReleaseCapture;
//    Perform(WM_SYSCOMMAND, SC_DRAGMOVE, 0);
//  end;
end;

procedure TMainForm.FrameTimerOnTimer(Sender: TObject);
begin
  if FImageIndex < High(FImageArray) then
    FImageIndex := FImageIndex + 1
  else
  begin
    case FRepeatCount of
      0: FImageIndex := 0;
      1:
      begin
        ModalResult := mrOk;
        Exit;
      end
    else
      begin
        FImageIndex := 0;
        FRepeatCount := FRepeatCount - 1;
      end;
    end;
  end;
  RenderFrame(FImageIndex);
end;

procedure TMainForm.ListSourceFiles(const ASourcePath: string;
  var AFileList: TStringList);
var
  Status: Integer;
  SearchRec: TSearchRec;
begin
  AFileList.Clear;
  Status := FindFirst(ASourcePath + '*.png', faAnyFile, SearchRec);
  try
    while Status = 0 do
    begin
      if (SearchRec.Attr and faDirectory = 0) then
        AFileList.Add(SearchRec.Name);
      Status := FindNext(SearchRec);
    end;
  finally
    FindClose(SearchRec);
  end;
end;

procedure TMainForm.LoadSourceFiles(const ASourcePath: string;
  AFileList: TStringList);
var
  I: Integer;
  BMPImage: TBitmap;
  PNGImage: TPNGImage;
begin
  BMPImage := nil;
  SetLength(FImageArray, AFileList.Count);
  try
    for I := 0 to AFileList.Count - 1 do
    begin
      BMPImage := TBitmap.Create;
      BMPImage.PixelFormat := pf32bit;
      PNGImage := TPNGImage.Create;
      try
        PNGImage.LoadFromFile(ASourcePath + AFileList[I]);
        BMPImage.Assign(PNGImage);
      finally
        PNGImage.Free;
      end;
      FImageArray[I] := BMPImage;
    end;
  except
    BMPImage.Free;
    ReleaseFrames;
  end;
end;

procedure TMainForm.ReleaseFrames;
var
  I: Integer;
begin
  for I := 0 to High(FImageArray) do
    FImageArray[I].Free;
  SetLength(FImageArray, 0);
end;

procedure TMainForm.RenderFrame(AFrameIndex: Integer);
var
  BlendFunction: TBlendFunction;
begin
  BlendFunction.BlendOp := AC_SRC_OVER;
  BlendFunction.BlendFlags := 0;
  BlendFunction.SourceConstantAlpha := 255;
  BlendFunction.AlphaFormat := AC_SRC_ALPHA;

  UpdateLayeredWindow(Handle, 0, nil, @FImageSize, FImageArray[AFrameIndex].Canvas.Handle,
    @FImagePos, 0, @BlendFunction, ULW_ALPHA);
end;

function TMainForm.ShowAnimation(WindowOwner: HWND; const ASourcePath: string;
  AFrameTime: Integer; ARepeatCount: Integer): TModalResult;
var
  FileList: TStringList;
  WindowLong: Longint;
begin
  Result := mrError;
  
  FileList := TStringList.Create;
  try
    ReleaseFrames;
    ListSourceFiles(ASourcePath, FileList);
    FileList.Sort;
    LoadSourceFiles(ASourcePath, FileList);
  finally
    FileList.Free;
  end;

  if Length(FImageArray) > 1 then
  begin
    FRepeatCount := ARepeatCount;
    FrameTimer.Interval := AFrameTime;
    ClientWidth := FImageArray[0].Width;
    ClientHeight := FImageArray[0].Height;

    FImagePos := Point(0, 0);
    FImageSize.cx := FImageArray[0].Width;
    FImageSize.cy := FImageArray[0].Height;

    WindowLong := GetWindowLong(Handle, GWL_EXSTYLE);
    WindowLong := WindowLong or WS_EX_LAYERED;
    SetWindowLong(Handle, GWL_EXSTYLE, WindowLong);
    WindowLong := WindowOwner;
    SetWindowLong(Handle, GWL_HWNDPARENT, WindowLong);

    Result := ShowModal;
  end;
end;

initialization

finalization
  ThemeServices.Free;

end.
